Data Sources:

https://www.kaggle.com/new-york-state/nys-children-in-foster-care-annually https://www.ncsc.org/Microsites/EveryKid/Home/Data-and-Reform-Efforts/Data-By-State.aspx https://www.acf.hhs.gov/cb/resource/trends-in-foster-care-and-adoption

library(readxl)
#library(sf)
library(usmap)
library(tidyverse)
library(viridis)
library(rvest)
library(plotly)
library(ggsn) # for scale bar `scalebar`

Read the data

#national dataset
nation_data<-read_excel("data/national_afcars_trends_2009_through_2018.xlsx",sheet="Data")

#State dataset
#Numbers of Children Served in Foster Care, by State
state_served <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="Served!A8:K60") %>%
gather(year,Served,'FY 2009':'FY 2018')

#Numbers of Children in Foster Care on September 30th, by State
state_inCare <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="In Care on September 30th!A8:K60") %>%
gather(year,InCare_Sep30,'FY 2009':'FY 2018')

#Numbers of Children Entering Foster Care, by State
state_entered <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="Entered!A8:K60") %>%
gather(year,Entered,'FY 2009':'FY 2018')

#Numbers of Children Exiting Foster Care, by State
state_exited <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="Exited!A8:K60") %>%
gather(year,Exited,'FY 2009':'FY 2018')

#Numbers of Children Waiting for Adoption, by State
state_waitingAdoption <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="Waiting for Adoption!A8:K60") %>%
gather(year,Waiting_Adoption,'FY 2009':'FY 2018')

#Numbers of Children Waiting for Adoption Whose Parental Rights Have Been Terminated, by State
state_parentalRightsTerminated <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="Parental Rights Terminated!A8:K60") %>%
gather(year,parental_rights_terminated,'FY 2009':'FY 2018')

#Numbers of Children Adopted, by State
state_adopted <- read_excel("data/afcars_state_data_tables_09thru18.xlsx",range="Adopted!A8:K60") %>%
gather(year,adopted,'FY 2009':'FY 2018')

Merge the data for all categories for states

merge_cols<-c("State","year")
#The merge argument only takes two values as input, so you have to do them separately:
#state_df<- merge(state_served,state_inCare,state_entered,state_exited,state_waitingAdoption,state_parentalRightsTerminated,state_adopted,by=c("State","year"))

state_data<- merge(state_served,state_inCare,by=merge_cols)
state_data<- merge(state_data,state_entered,by=merge_cols)
state_data<- merge(state_data,state_exited,by=merge_cols)
state_data<- merge(state_data,state_waitingAdoption,by=merge_cols)
state_data<- merge(state_data,state_parentalRightsTerminated,by=merge_cols)
state_data<- merge(state_data,state_adopted,by=merge_cols)

CHeck the data

head(state_data)
##     State    year Served InCare_Sep30 Entered Exited Waiting_Adoption
## 1 Alabama FY 2009   9677         6179    3080   3498             1475
## 2 Alabama FY 2010   8119         5350    3063   2770             1271
## 3 Alabama FY 2011   8395         5253    3257   3143             1297
## 4 Alabama FY 2012   7907         4561    2763   3346             1156
## 5 Alabama FY 2013   7322         4435    3041   2888             1084
## 6 Alabama FY 2014   7520         4526    3192   2994             1044
##   parental_rights_terminated adopted
## 1                        882     638
## 2                        757     606
## 3                        701     447
## 4                        543     587
## 5                        615     532
## 6                        573     544

Get US Map data

us_map <- usmap::us_map()

Rename state column for plot_usmap() function

state_data <- state_data %>% rename(state = State)

Plot Served for 2009

https://liuyanguu.github.io/post/2019/04/17/ggplot-heatmap-us-50-states-map-and-china-province-map/

state_data_2009 <- state_data %>% filter(year == 'FY 2009')

g <- usmap::plot_usmap(data = state_data_2009,values = "Served") +
  scale_fill_viridis("Served",begin = 0.06,end=0.8,option = "plasma") +
  ggtitle("Orphans Served by each state in 2009") +
  theme_minimal() +
  theme(legend.position = "bottom",
        legend.title=element_text(size=10), 
        legend.text=element_text(size=5))
ggplotly(g)